(defvar which-key-buffer-position 'bottom
"Position of which-key buffer.")
(defvar which-key-vertical-buffer-width 60
- "Width of which-key buffer .")
+ "Width of which-key buffer.")
+(defvar which-key-horizontal-buffer-height 20
+ "Height of which-key buffer.")
(defvar which-key-display-method 'minibuffer
"Controls the method used to display the keys. The default is
minibuffer, but other possibilities are 'popwin and
"Toggle which-key-mode."
:global t
:lighter " WK"
- (if which-key-mode
- (progn
- (unless which-key--setup-p (which-key/setup))
- (add-hook 'focus-out-hook 'which-key/stop-open-timer)
- (add-hook 'focus-in-hook 'which-key/start-open-timer)
- (which-key/make-display-method-aliases which-key-display-method)
- (which-key/start-open-timer))
- (remove-hook 'focus-out-hook 'which-key/stop-open-timer)
- (remove-hook 'focus-in-hook 'which-key/start-open-timer)
- (which-key/stop-open-timer)))
+ (if which-key-mode
+ (progn
+ (unless which-key--setup-p (which-key/setup))
+ (add-hook 'focus-out-hook 'which-key/stop-open-timer)
+ (add-hook 'focus-in-hook 'which-key/start-open-timer)
+ (which-key/start-open-timer))
+ (remove-hook 'focus-out-hook 'which-key/stop-open-timer)
+ (remove-hook 'focus-in-hook 'which-key/start-open-timer)
+ (which-key/stop-open-timer)))
(defun which-key/setup ()
"Create buffer for which-key."
(setq-local cursor-in-non-selected-windows nil))
(setq which-key--setup-p t))
-;; Helper functions
+;; Timers
-(defsubst which-key/truncate-description (desc)
- "Truncate DESC description to `which-key-max-description-length'."
- (if (> (length desc) which-key-max-description-length)
- (concat (substring desc 0 which-key-max-description-length) "..")
- desc))
+(defun which-key/start-open-timer ()
+ "Activate idle timer."
+ (which-key/stop-open-timer) ; start over
+ (setq which-key--open-timer
+ (run-with-idle-timer which-key-idle-delay t 'which-key/update)))
-(defun which-key/available-lines ()
- "Only works for minibuffer right now."
- (when (eq which-key-display-method 'minibuffer)
- (if (floatp max-mini-window-height)
- (floor (* (frame-text-lines)
- max-mini-window-height))
- max-mini-window-height)))
+(defun which-key/stop-open-timer ()
+ "Deactivate idle timer."
+ (when which-key--open-timer (cancel-timer which-key--open-timer)))
-(defun which-key/replace-strings-from-alist (replacements)
- "Find and replace text in buffer according to REPLACEMENTS,
-which is an alist where the car of each element is the text to
-replace and the cdr is the replacement text."
- (dolist (rep replacements)
- (save-excursion
- (goto-char (point-min))
- (while (or (search-forward (car rep) nil t))
- (replace-match (cdr rep) t t)))))
+(defun which-key/start-close-timer ()
+ "Activate idle timer."
+ (which-key/stop-close-timer) ; start over
+ (setq which-key--close-timer
+ (run-at-time which-key-close-buffer-idle-delay
+ nil 'which-key/hide-buffer)))
-;; in case I decide to add padding
-;; (defsubst which-key/buffer-height (line-breaks) line-breaks)
+(defun which-key/stop-close-timer ()
+ "Deactivate idle timer."
+ (when which-key--close-timer (cancel-timer which-key--close-timer)))
+
+;; Update
+
+(defun which-key/update ()
+ "Fill which-key--buffer with key descriptions and reformat.
+Finally, show the buffer."
+ (let ((key (this-single-command-keys)))
+ (if (> (length key) 0)
+ (progn
+ (which-key/stop-close-timer)
+ (which-key/hide-buffer)
+ (let* ((buf (current-buffer))
+ ;; (bottom-or-top (member which-key-buffer-position '(top bottom)))
+ ;; get formatted key bindings
+ (fmt-width-cons (which-key/get-formatted-key-bindings buf key))
+ (formatted-keys (car fmt-width-cons))
+ (column-width (cdr fmt-width-cons))
+ (buffer-width (which-key/buffer-width column-width (window-width)))
+ ;; populate target buffer
+ (n-lines (which-key/populate-buffer formatted-keys column-width buffer-width)))
+ ;; show buffer
+ (when (which-key/show-buffer n-lines buffer-width)
+ (which-key/start-close-timer))))
+ ;; command finished maybe close the window
+ (which-key/hide-buffer))))
+
+;; Show/hide guide buffer
+
+(defun which-key/hide-buffer ()
+ (when (buffer-live-p which-key--buffer)
+ (delete-windows-on which-key--buffer)))
+
+(defun which-key/show-buffer (height width)
+ "Show guide window.
+Return nil if no window is shown, or if there is no need to start the
+closing timer."
+ (cl-case which-key-display-method
+ (minibuffer (which-key/show-buffer-minibuf height width))
+ (side-window (which-key/show-buffer-db height width))))
+
+(defun which-key/show-buffer-minibuf (height width)
+ nil)
+
+(defun which-key/show-buffer-db (height width)
+ (let* ((side which-key-buffer-position)
+ (alist (delq nil (list (when side (cons 'side side))
+ (when height (cons 'window-height height))
+ (when width (cons 'window-width width))))))
+ (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist))))
+
+;; Size functions
(defun which-key/buffer-width (column-width sel-window-width)
- (cond ((eq which-key-display-method 'minibuffer)
- (frame-text-cols))
- ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window)
- (member which-key-buffer-position '(left right)))
- (min which-key-vertical-buffer-width column-width))
- ((eq which-key-buffer-display-function 'display-buffer-in-side-window)
- (frame-text-width))
- ;; ((eq which-key-buffer-display-function 'display-buffer-below-selected)
- ;; sel-window-width)
- (t nil)))
+ (cl-case which-key-display-method
+ (minibuffer (which-key/buffer-width-minibuf column-width sel-window-width))
+ (side-window (which-key/buffer-width-db column-width sel-window-width))))
-(defun which-key/format-matches (unformatted max-len-key max-len-desc)
- "Turn each key-desc-cons in UNFORMATTED into formatted
-strings (including text properties), and pad with spaces so that
-all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the
-longest key and description in the buffer, respectively."
- (mapcar
- (lambda (key-desc-cons)
- (let* ((key (car key-desc-cons))
- (desc (cdr key-desc-cons))
- (group (string-match-p "^group:" desc))
- (desc (if group (substring desc 6) desc))
- (prefix (string-match-p "^Prefix" desc))
- (desc (if (or prefix group) (concat "+" desc) desc))
- (desc-face (if (or prefix group)
- 'font-lock-keyword-face 'font-lock-function-name-face))
- ;; (sign (if (or prefix group) "▶" "→"))
- (sign "→")
- (desc (which-key/truncate-description desc))
- ;; pad keys to max-len-key
- (padded-key (s-pad-left max-len-key " " key))
- (padded-desc (s-pad-right max-len-desc " " desc)))
- (format (concat (propertize "%s" 'face 'font-lock-constant-face) " "
- (propertize sign 'face 'font-lock-comment-face) " "
- (propertize "%s" 'face desc-face) " ")
- padded-key padded-desc)))
- unformatted))
+(defun which-key/buffer-width-minibuf (column-width sel-window-width)
+ (frame-text-cols))
-;; "Core" functions
+(defun which-key/buffer-width-db (column-width sel-window-width)
+ (if (member which-key-buffer-position '(left right))
+ (min which-key-vertical-buffer-width column-width)
+ (frame-width)))
+
+(defun which-key/available-lines ()
+ (cl-case which-key-display-method
+ (minibuffer (which-key/available-lines-minibuf))
+ (side-window (which-key/available-lines-db))))
+
+(defun which-key/available-lines-minibuf ()
+ "Only works for minibuffer right now."
+ (if (floatp max-mini-window-height)
+ (floor (* (frame-text-lines)
+ max-mini-window-height))
+ max-mini-window-height))
+
+(defun which-key/available-lines-db ()
+ (if (member which-key-buffer-position '(left right))
+ (frame-height)
+ ;; FIXME: change to something like (min which-*-height (calculate-max-height))
+ which-key-horizontal-buffer-height))
+
+;; Buffer contents functions
(defun which-key/get-formatted-key-bindings (buffer key)
(let ((max-len-key 0) (max-len-desc 0)
(setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))
(if (eq which-key-display-method 'minibuffer)
(let (message-log-max) (message "%s" str-to-insert))
- (insert str-to-insert)))
+ (with-current-buffer which-key--buffer
+ (insert str-to-insert))))
n-lines))
-(defun which-key/update ()
- "Fill which-key--buffer with key descriptions and reformat.
-Finally, show the buffer."
- (let ((key (this-single-command-keys)))
- (if (> (length key) 0)
- (progn
- (when which-key--close-timer (cancel-timer which-key--close-timer))
- (which-key/hide-buffer)
- (let* ((buf (current-buffer))
- (bottom-or-top (member which-key-buffer-position '(top bottom)))
- ;; get formatted key bindings
- (fmt-width-cons (which-key/get-formatted-key-bindings buf key))
- (formatted-keys (car fmt-width-cons))
- (column-width (cdr fmt-width-cons))
- (buffer-width (which-key/buffer-width column-width (window-width)))
- n-lines)
- ;; populate target buffer
- (setq n-lines (which-key/populate-buffer
- formatted-keys column-width buffer-width))
- ;; show buffer
- (unless (eq which-key-display-method 'minibuffer)
- (setq which-key--window (which-key/show-buffer n-lines buffer-width)
- which-key--close-timer (run-at-time
- which-key-close-buffer-idle-delay
- nil 'which-key/hide-buffer)))))
- ;; command finished maybe close the window
- (which-key/hide-buffer))))
-
-;; Timers
+(defun which-key/replace-strings-from-alist (replacements)
+ "Find and replace text in buffer according to REPLACEMENTS,
+which is an alist where the car of each element is the text to
+replace and the cdr is the replacement text."
+ (dolist (rep replacements)
+ (save-excursion
+ (goto-char (point-min))
+ (while (or (search-forward (car rep) nil t))
+ (replace-match (cdr rep) t t)))))
-(defun which-key/start-open-timer ()
- "Activate idle timer."
- (when which-key--open-timer (cancel-timer which-key--open-timer)); start over
- (setq which-key--open-timer
- (run-with-idle-timer which-key-idle-delay t 'which-key/update)))
+(defun which-key/format-matches (unformatted max-len-key max-len-desc)
+ "Turn each key-desc-cons in UNFORMATTED into formatted
+strings (including text properties), and pad with spaces so that
+all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the
+longest key and description in the buffer, respectively."
+ (mapcar
+ (lambda (key-desc-cons)
+ (let* ((key (car key-desc-cons))
+ (desc (cdr key-desc-cons))
+ (group (string-match-p "^group:" desc))
+ (desc (if group (substring desc 6) desc))
+ (prefix (string-match-p "^Prefix" desc))
+ (desc (if (or prefix group) (concat "+" desc) desc))
+ (desc-face (if (or prefix group)
+ 'font-lock-keyword-face 'font-lock-function-name-face))
+ ;; (sign (if (or prefix group) "▶" "→"))
+ (sign "→")
+ (desc (which-key/truncate-description desc))
+ ;; pad keys to max-len-key
+ (padded-key (s-pad-left max-len-key " " key))
+ (padded-desc (s-pad-right max-len-desc " " desc)))
+ (format (concat (propertize "%s" 'face 'font-lock-constant-face) " "
+ (propertize sign 'face 'font-lock-comment-face) " "
+ (propertize "%s" 'face desc-face) " ")
+ padded-key padded-desc)))
+ unformatted))
-(defun which-key/stop-open-timer ()
- "Deactivate idle timer."
- (cancel-timer which-key--open-timer))
-
-;; Display functions
-
-(defun which-key/show-buffer-display-buffer (height width)
- (let ((side which-key-buffer-position) alist)
- (setq alist (list (when side (cons 'side side))
- (when height (cons 'window-height height))
- (when width (cons 'window-width width))))
- (display-buffer "*which-key*" (cons which-key-buffer-display-function alist))))
-
-(defun which-key/hide-buffer-display-buffer ()
- (when (window-live-p which-key--window)
- (delete-window which-key--window)))
-
-(defun which-key/show-buffer-popwin (height width)
- "Using popwin popup buffer with dimensions HEIGHT and WIDTH."
- (popwin:popup-buffer which-key-buffer-name
- :height height
- :width width
- :noselect t
- :position which-key-buffer-position))
-
-(defun which-key/hide-buffer-popwin ()
- "Hide popwin buffer."
- (when (eq popwin:popup-buffer (get-buffer which-key--buffer))
- (popwin:close-popup-window)))
-
-(defun which-key/make-display-method-aliases (method)
- (cond
- ((eq method 'minibuffer)
- (defun which-key/hide-buffer ()))
- ((member method '(popwin display-buffer))
- (defalias 'which-key/show-buffer
- (intern (concat "which-key/show-buffer-" (symbol-name method))))
- (defalias 'which-key/hide-buffer
- (intern (concat "which-key/hide-buffer-" (symbol-name method)))))
- (t (error "error: Invalid choice for which-key-display-method"))))
-
-(provide 'which-key)
-
-;;; which-key.el ends here
+(defsubst which-key/truncate-description (desc)
+ "Truncate DESC description to `which-key-max-description-length'."
+ (if (> (length desc) which-key-max-description-length)
+ (concat (substring desc 0 which-key-max-description-length) "..")
+ desc))
projects / emacs.git / commitdiff